home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok77.lha / GadToolsSupport / GadToolsSupportTest.mod < prev    next >
Text File  |  1993-08-15  |  11KB  |  251 lines
  1. (****************************************************************************
  2. :Program.       GadToolsSupportTest.mod
  3. :Contents.      TestModule for Gadgets [gvm]
  4. :Author.        Richard Günther [gvm]
  5. :Address.       HeilbronnerStr.267, 7410 Reutlingen
  6. :Phone.         07121/66432
  7. :Copyright.     Public Domain
  8. :Language.      Oberon
  9. :Translator.    AmigaOberon v2.14d
  10. :History.       V1.0 [gvm] 15-May-92  first implementation
  11. :History.       V1.1 [gvm] 07-July-92 added menus
  12. :Imports.       GadToolsSupport [gvm]
  13. :Bugs.          OS2.0 required (isn't really a bug, is it?)
  14. ****************************************************************************)
  15.  
  16. MODULE GadToolsSupportTest ;
  17.  
  18. IMPORT  S : SYSTEM,
  19.         I : Intuition,
  20.         GT: GadTools,
  21.         GS: GadToolsSupport,
  22.         G : Graphics,
  23.         U : Utility,
  24.         E : Exec,
  25.         NoGuruRq ;
  26.  
  27. CONST mxLabels  = GS.labels4(S.ADR("show libs"),
  28.                              S.ADR("show devices"),
  29.                              S.ADR("show resources"),
  30.                              S.ADR("show ports"),NIL) ;
  31. CONST cyLabels  = GS.labels4(S.ADR("grey"),
  32.                              S.ADR("black"),
  33.                              S.ADR("white"),
  34.                              S.ADR("blue"),NIL) ;
  35.  
  36. VAR w         : I.WindowPtr ;
  37.     s         : I.ScreenPtr ;
  38.     iMsg      : I.IntuiMessagePtr ;
  39.     win       : GS.WinPtr ;
  40.     g         : I.GadgetPtr ;
  41.     quit      : BOOLEAN ;
  42.  
  43.     lv,mx     : I.GadgetPtr ;     (* used for listView Gadget and mx Gadget *)
  44.     lvLabels  : E.ListPtr ;
  45.     nm        : I.GadgetPtr ;     (* number Gadget *)
  46.     tx        : I.GadgetPtr ;     (* text Gadget *)
  47.     cy,pa     : I.GadgetPtr ;     (* cycle and palette Gadget *)
  48.     cb        : I.GadgetPtr ;     (* checkBox Gadget *)
  49.     sc,sl     : I.GadgetPtr ;     (* scroller and slider Gadget *)
  50.     checked   : BOOLEAN ;
  51.     code,num  : INTEGER ;
  52.  
  53.  
  54.  
  55. PROCEDURE OpenAll ;
  56. BEGIN
  57.   w:=I.OpenWindowTagsA(NIL,I.waLeft,60,I.waTop,20,I.waWidth,550,I.waHeight,210,
  58.                            I.waIDCMP,S.VAL(LONGINT,GS.allIDCMP+
  59.                                            LONGSET{I.vanillaKey,I.closeWindow,I.refreshWindow,I.menuPick}),
  60.                            I.waDragBar,-1,I.waCloseGadget,-1,I.waDepthGadget,-1,
  61.                            I.waActivate,-1,
  62.                            I.waTitle,S.ADR("Demo of using Gadgets and Menus with GadToolsSupport"),
  63.                            I.waMouseQueue,1,I.waSimpleRefresh,-1,
  64.                            U.done) ;
  65.   IF NOT GS.Init(win,s,w) THEN HALT(20) END ;
  66.  
  67. GS.WaitForDo(win) ;
  68.   GS.NewGadget(win,225,190,100,15,"_QUIT",GS.center,100) ;
  69.   g:=GS.CreateGadget(win,GT.buttonKind,GT.underscore,GS.uChar,U.done) ;
  70.  
  71.   GS.NewGadget(win,130,20,100,12,"TextKind",GS.left,1) ;
  72.   tx:=GS.CreateGadget(win,GT.textKind,GT.txText,S.ADR("Example"),
  73.                                       GT.txBorder,-1,U.done) ;
  74.  
  75.   GS.NewGadget(win,130,40,100,12,"NumberKind",GS.left,2) ;
  76.   nm:=GS.CreateGadget(win,GT.numberKind,GT.nmNumber,0,GT.nmBorder,-1,U.done) ;
  77.  
  78.   GS.NewGadget(win,130,60,100,12,"CycleKind",GS.left,3) ;
  79.   cy:=GS.CreateGadget(win,GT.cycleKind,GT.cyLabels,S.ADR(cyLabels),
  80.                                        GT.cyActive,1,U.done) ;
  81.  
  82.  (* slLevelFormat : %[-][minWidth][.maxWidth]type
  83.              type : ld=decimal ;=lx hex ; lc=character *)
  84.   GS.NewGadget(win,130,80,100,12,"SliderKind",GS.left,4) ;
  85.   sl:=GS.CreateGadget(win,GT.sliderKind,GT.slMin,0,GT.slMax,255,
  86.                                         GT.slLevel,0,GT.slMaxLevelLen,20,
  87.                                         GT.slLevelFormat,S.ADR("No %-3ld"),
  88.                                         GT.slLevelPlace,S.VAL(LONGINT,GS.right),
  89.                                         U.done) ;
  90.  
  91.   GS.NewGadget(win,130,100,100,12,"ButtonKind",GS.center,10) ;
  92.   g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
  93.  
  94.      (* if readonly then showselected and selected make no sense, if not, *)
  95. (* showselected must contain a stringgadget (for modifying) or NIL (show only) *)
  96.   lvLabels:=S.ADR(E.exec.libList) ;
  97.   GS.NewGadget(win,30,130,200,50,"ListViewKind",GS.above+GS.highlight,6) ;
  98.   lv:=GS.CreateGadget(win,GT.listViewKind,GT.lvTop,0,
  99.                                           GT.lvLabels,lvLabels,
  100.                                           GT.lvReadOnly,-1,
  101.                                           GT.lvScrollWidth,15,
  102.                                           U.done) ;
  103.  
  104.   GS.NewGadget(win,320,20,100,12,"StringKind",GS.right,12) ;
  105.   g:=GS.CreateGadget(win,GT.stringKind,GT.stString,S.ADR("Example"),
  106.                                        GT.stMaxChars,32,U.done) ;
  107.  
  108.   GS.NewGadget(win,320,40,100,12,"IntegerKind",GS.right,13) ;
  109.   g:=GS.CreateGadget(win,GT.integerKind,GT.inNumber,0,
  110.                                         GT.inMaxChars,10,U.done) ;
  111.  
  112.   GS.NewGadget(win,320,60,120,12,"PaletteKind",GS.right,14) ;
  113.   pa:=GS.CreateGadget(win,GT.paletteKind,GT.paDepth,2,
  114.                                          GT.paColor,1,
  115.                                          GT.paColorOffset,0,
  116.                                          GT.paIndicatorWidth,24,
  117.                                          U.done) ;
  118.  
  119.   GS.NewGadget(win,320,80,112,12,"ScrollerKind",GS.right,5) ;
  120.   sc:=GS.CreateGadget(win,GT.scrollerKind,GT.scTop,0,
  121.                                           GT.scTotal,259,
  122.                                           GT.scVisible,4,
  123.                                           GT.scArrows,18,U.done) ;
  124.  
  125.   checked:=TRUE ;
  126.   GS.NewGadget(win,320,100,100,12,"CheckboxKind",GS.right,11) ;
  127.   cb:=GS.CreateGadget(win,GT.checkBoxKind,GT.cbChecked,-1,U.done) ;
  128.  
  129.  
  130.            (* text is ignored, textpos is textpos of mx-items ! *)
  131.   GS.NewGadget(win,320,131,250,50,"",GS.right,15) ;
  132.   mx:=GS.CreateGadget(win,GT.mxKind,GT.mxLabels,S.ADR(mxLabels),
  133.                                     GT.mxActive,0,
  134.                                     GT.mxSpacing,3,
  135.                                     U.done) ;
  136. GS.Do(win) ;
  137. GS.BeginMenus(win) ;
  138.   GS.MenuTitle(win,"Project",TRUE) ;
  139.     GS.MenuItem(win,"About","",{}) ;
  140.       GS.MenuSubItem(win,"GadgetTest  (c) 1992 by","",{},GS.none) ;
  141.       GS.MenuSubItem(win,"    Richard Günther","",{},GS.none) ;
  142.     GS.MenuItem(win,"QUIT","q",{}) ;
  143.   GS.MenuTitle(win,"Gadgets",TRUE) ;
  144.     GS.MenuItem(win,"Colors","",{}) ;
  145.       GS.MenuSubItem(win,"grey","",{},GS.none) ;
  146.       GS.MenuSubItem(win,"black","",{},GS.none) ;
  147.       GS.MenuSubItem(win,"white","",{},GS.none) ;
  148.       GS.MenuSubItem(win,"blue","",{},GS.none) ;
  149.     GS.MenuItem(win,"Show","",{}) ;
  150.       GS.MenuSubItem(win,"libs","",{},GS.none) ;
  151.       GS.MenuSubItem(win,"devices","",{},GS.none) ;
  152.       GS.MenuSubItem(win,"resources","",{},GS.none) ;
  153.       GS.MenuSubItem(win,"ports","",{},GS.none) ;
  154.     GS.MenuItem(win,"Checkbox","",{}) ;
  155.       GS.MenuSubItem(win,"set","",{},GS.none) ;
  156.       GS.MenuSubItem(win,"clear","",{},GS.none) ;
  157. IF ~GS.DoMenus(win,0) THEN HALT(20) END ;
  158. END OpenAll ;
  159.  
  160.  
  161. BEGIN
  162.   OpenAll ;
  163.   quit:=FALSE ;
  164.   REPEAT
  165.     E.WaitPort(w.userPort) ;
  166.     iMsg:=GT.GetIMsg(w.userPort) ;
  167.     WHILE iMsg#NIL DO
  168.       IF I.refreshWindow IN iMsg.class THEN
  169.         GT.BeginRefresh(w) ; GT.EndRefresh(w,I.LTRUE) ;
  170.       ELSIF I.menuPick IN iMsg.class THEN
  171.         code:=iMsg.code ;
  172.         WHILE code#I.menuNull DO
  173.           CASE I.MenuNum(code) OF
  174.             0: IF I.ItemNum(code)=1 THEN quit:=TRUE END ;
  175.           | 1: CASE I.ItemNum(code) OF
  176.                  0: num:=I.SubNum(code) ;
  177.                     IF num#I.menuNull THEN
  178.                       GS.SetGadgetAttrs(win,pa,GT.paColor,num,U.done) ;
  179.                       GS.SetGadgetAttrs(win,cy,GT.cyActive,num,U.done) ;
  180.                     END ;
  181.                | 1: num:=I.SubNum(code) ;
  182.                     CASE num OF
  183.                       0 : lvLabels:=S.ADR(E.exec.libList)
  184.                     | 1 : lvLabels:=S.ADR(E.exec.deviceList)
  185.                     | 2 : lvLabels:=S.ADR(E.exec.resourceList)
  186.                     | 3 : lvLabels:=S.ADR(E.exec.portList) ;
  187.                     END ;
  188.                     GS.SetGadgetAttrs(win,lv,GT.lvLabels,lvLabels,
  189.                                              GT.lvTop,0,U.done) ;
  190.                     GS.SetGadgetAttrs(win,mx,GT.mxActive,num,U.done) ;
  191.                | 2: IF I.SubNum(code)=0 THEN checked:=TRUE ;
  192.                                         ELSE checked:=FALSE ;
  193.                     END ;
  194.                     GS.SetGadgetAttrs(win,cb,GT.cbChecked,S.VAL(SHORTINT,checked),U.done) ;
  195.                END ;
  196.           END ;
  197.           code:=GS.NextSelected(win,code) ;
  198.         END ;
  199.       ELSIF I.gadgetUp IN iMsg.class THEN
  200.         g:=iMsg.iAddress ;
  201.         CASE g.gadgetID OF
  202.           100: quit:=TRUE ; (* QUIT *)
  203.         |  13: (* integer (connected with number) *)
  204.                GS.SetGadgetAttrs(win,nm,GT.nmNumber,g.specialInfo(I.StringInfo).longInt,
  205.                                         U.done) ;
  206.         |  12: (* string (connected with text) *)
  207.                GS.SetGadgetAttrs(win,tx,GT.txText,g.specialInfo(I.StringInfo).buffer,
  208.                                         U.done) ;
  209.         |   3: (* cycle (connected with palette) *)
  210.                GS.SetGadgetAttrs(win,pa,GT.paColor,iMsg.code,U.done) ;
  211.         |  14: (* palette (connected with cycle) *)
  212.                GS.SetGadgetAttrs(win,cy,GT.cyActive,iMsg.code,U.done) ;
  213.         |  11: checked:=~checked ; (* checkbox (connected with button) *)
  214.         |  10: checked:=~checked ; (* button (connected with checkbox) *)
  215.                GS.SetGadgetAttrs(win,cb,GT.cbChecked,S.VAL(SHORTINT,checked),U.done) ;
  216.         ELSE I.DisplayBeep(s)
  217.         END ;
  218.       ELSIF I.gadgetDown IN iMsg.class THEN
  219.         g:=iMsg.iAddress ;
  220.         IF g.gadgetID=15 THEN
  221.           CASE iMsg.code OF
  222.             0 : lvLabels:=S.ADR(E.exec.libList)
  223.           | 1 : lvLabels:=S.ADR(E.exec.deviceList)
  224.           | 2 : lvLabels:=S.ADR(E.exec.resourceList)
  225.           | 3 : lvLabels:=S.ADR(E.exec.portList) ;
  226.           END ;
  227.           GS.SetGadgetAttrs(win,lv,GT.lvLabels,lvLabels,
  228.                                    GT.lvTop,0,U.done) ;
  229.         ELSE I.DisplayBeep(s)
  230.         END ;
  231.       ELSIF I.mouseMove IN iMsg.class THEN
  232.         g:=iMsg.iAddress ;
  233.         IF g.gadgetID=4 THEN    (* slider *)
  234.           GS.SetGadgetAttrs(win,sc,GT.scTop,iMsg.code,U.done) ;
  235.         ELSIF g.gadgetID=5 THEN (* scroller *)
  236.           GS.SetGadgetAttrs(win,sl,GT.slLevel,iMsg.code,U.done) ;
  237.         END ;
  238.       ELSIF I.vanillaKey IN iMsg.class THEN
  239.         IF iMsg.code=ORD("Q") THEN quit:=TRUE END ;     (* Q - Key *)
  240.       ELSIF I.closeWindow IN iMsg.class THEN quit:=TRUE ;
  241.       END ;
  242.       GT.ReplyIMsg(iMsg) ;
  243.       iMsg:=GT.GetIMsg(w.userPort) ;
  244.     END ;
  245.   UNTIL quit ;
  246.  
  247. CLOSE
  248.   IF w#NIL THEN I.CloseWindow(w) END ;
  249.   IF (win#NIL) THEN GS.Dispose(win) END ;
  250. END GadToolsSupportTest.
  251.